home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / pbc22b.zip / PBC$BAS.ZIP / FORCEMAT.BAS < prev    next >
BASIC Source File  |  1993-02-10  |  1KB  |  51 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB StripChar (St$, Ch$, StLen%)
  8.  
  9. FUNCTION ForceMatch$(Pattern$, SourceFile$)
  10.    a$ = Pattern$
  11.    GOSUB Regularize
  12.    Pat$ = a$
  13.    a$ = SourceFile$
  14.    GOSUB Regularize
  15.    Src$ = a$
  16.    FOR tmp% = 1 TO 12
  17.       IF MID$(Pat$, tmp%, 1) = "?" THEN
  18.          Result$ = Result$ + MID$(Src$, tmp%, 1)
  19.       ELSE
  20.          Result$ = Result$ + MID$(Pat$, tmp%, 1)
  21.       END IF
  22.    NEXT
  23.    StripChar Result$, " ", tmp%
  24.    ForceMatch$ = LEFT$(Result$, tmp%)
  25.    EXIT FUNCTION
  26.  
  27. Regularize:
  28.    t% = INSTR(a$, ".")
  29.    IF t% THEN
  30.       l$ = LEFT$(LEFT$(a$, t% - 1), 8)
  31.       r$ = LEFT$(MID$(a$, t% + 1), 3)
  32.    ELSE
  33.       l$ = LEFT$(a$, 8)
  34.       r$ = ""
  35.    END IF
  36.    t% = INSTR(l$, "*")
  37.    IF t% THEN
  38.       l$ = LEFT$(l$, t% - 1) + STRING$(9 - t%, "?")
  39.    ELSE
  40.       l$ = LEFT$(l$ + SPACE$(8), 8)
  41.    END IF
  42.    t% = INSTR(r$, "*")
  43.    IF t% THEN
  44.       r$ = LEFT$(r$, t% - 1) + STRING$(4 - t%, "?")
  45.    ELSE
  46.       r$ = LEFT$(r$ + SPACE$(3), 3)
  47.    END IF
  48.    a$ = l$ + "." + r$
  49.    RETURN
  50. END FUNCTION
  51.